#ucitavanje paketa Učitajmo potrebne pakete

library(dplyr)

#Učitavanje podataka

Učitajmo podatke iz .csv file-a

bigFiveData = read.csv("../big_five_scores.csv")
dim(bigFiveData)
## [1] 307313      9

Podaci se sastoje od 307 313 testiranih ljudi i 9 varijabli koje promatramo.

Popis varijabli koje promatramo:

names(bigFiveData)
## [1] "case_id"                 "country"                
## [3] "age"                     "sex"                    
## [5] "agreeable_score"         "extraversion_score"     
## [7] "openness_score"          "conscientiousness_score"
## [9] "neuroticism_score"

Za testirane sudionike u tablici su navedeni njihovi podaci (godina, zemlja, spol) te 5 faktora koje promtramo(ekstraverzija, ugodnost, savjesnost, neuroticizam i otvorenost)

Možemo promotriti ponašanje varijabli.

summary(bigFiveData)
##     case_id         country               age             sex       
##  Min.   :     1   Length:307313      Min.   :10.00   Min.   :1.000  
##  1st Qu.: 83653   Class :character   1st Qu.:18.00   1st Qu.:1.000  
##  Median :166286   Mode  :character   Median :22.00   Median :2.000  
##  Mean   :166682                      Mean   :25.19   Mean   :1.602  
##  3rd Qu.:249627                      3rd Qu.:29.00   3rd Qu.:2.000  
##  Max.   :334161                      Max.   :99.00   Max.   :2.000  
##  agreeable_score  extraversion_score openness_score   conscientiousness_score
##  Min.   :0.2000   Min.   :0.2000     Min.   :0.2533   Min.   :0.2067         
##  1st Qu.:0.6400   1st Qu.:0.6000     1st Qu.:0.6733   1st Qu.:0.6300         
##  Median :0.7033   Median :0.6800     Median :0.7367   Median :0.7067         
##  Mean   :0.6968   Mean   :0.6723     Mean   :0.7339   Mean   :0.7020         
##  3rd Qu.:0.7633   3rd Qu.:0.7500     3rd Qu.:0.7967   3rd Qu.:0.7767         
##  Max.   :1.0000   Max.   :0.9933     Max.   :0.9967   Max.   :1.0000         
##  neuroticism_score
##  Min.   :0.1967   
##  1st Qu.:0.4867   
##  Median :0.5700   
##  Mean   :0.5744   
##  3rd Qu.:0.6600   
##  Max.   :0.9967
sapply(bigFiveData, class)
##                 case_id                 country                     age 
##               "integer"             "character"               "integer" 
##                     sex         agreeable_score      extraversion_score 
##               "integer"               "numeric"               "numeric" 
##          openness_score conscientiousness_score       neuroticism_score 
##               "numeric"               "numeric"               "numeric"

Vidimo iz prioloženog tip podataka danih varijabli. Zemlja je zadana stringom, dok su ostale varijable brojčane(int ili numeric). Svi faktori koje promatramo su numeric tipa i imaju vrijednost od 0 do 1.

Sada gledamo postoje li u našem skupu podataka nedostajuće vrijednosti jer one mogu poremetiti rezultate testa. Promatramo sve varijable i brojimo koliko je NA vrijednosti ako ih ima.

for (col_name in names(bigFiveData)){
  if (sum(is.na(bigFiveData[,col_name])) > 0){
    cat('Ukupno nedostajućih vrijednosti za varijablu ',col_name, ': ', sum(is.na(bigFiveData[,col_name])),'\n')
  }
}

Po rezultatima vidimo da nemamo NA vrijednosti(neodostajućih) ni u jednoj varijabli. Podaci su uredni.

Promotrimo sada kako izgledaju varijable koje dobijemo kao informaciju od ispitanika (godine, zemlja, spol)

Prov ćemo gledati godine jer je to numerička:

hist(bigFiveData$age,main='Age', xlab='Age', ylab='Frequency')

Vidimo da rezultat nije normalne dristirbucije, pa ćemo pokušati log transformacijom približiti normalnoj.

hist(log(bigFiveData$age),main='Age',xlab='Age',ylab='Frequency', breaks=50)

Vidimo da smo se uspjeli približiti normalnoj razdiobi.

Sad ćemo pogledati kategorijske varijable (spol i država)

#broj Muskih i Zenskih ispitanika
print("Podjela na M i Z: ")
## [1] "Podjela na M i Z: "
table(bigFiveData$sex)
## 
##      1      2 
## 122164 185149
barplot(table(bigFiveData$sex), las=2, main='Sex')

table(bigFiveData$country)
## 
##            Afghanista    Albania    Algeria    Andorra     Angola   Anguilla 
##        172        624        527        360        167         97         83 
## Antarctica    Antigua Arabian Gu  Argentina    Armenia      Aruba  Australia 
##         74         36         32        235         40         23      10400 
##    Austria Azerbaijan    Bahamas    Bahrain Bangladesh   Barbados    Belarus 
##        223         47         83         42         63         57         33 
##    Belgium     Belize      Benin    Bermuda     Bhutan    Bolivia     Borneo 
##        663         26          7         35         13         33         11 
## Bosnia Her   Botswana Bouvet Isl     Brazil British In British Vi     Brunei 
##         77         10          3        661         21         60         22 
##   Bulgaria Burkina Fa      Burma Burma(Myan    Burundi   Cambodia   Cameroon 
##        176          6          6         18          7         19         26 
##     Canada Cape Verde Cayman Isl Central Af       Chad      Chile      China 
##      21798         66         63         19          8         81        915 
##  Christmas Cocos (Kee   Columbia    Comoros      Congo Cook Islan Costa Rica 
##          3          4        209          4          6          5         75 
##    Croatia       Cuba     Cyprus Czech Repu    Denmark   Djibouti   Dominica 
##        307         76         77        108        614          5         10 
##  Dominican East Timor    Ecuador      Egypt El Salvado Equatorial    Eritrea 
##         75          2         56        286         47          1          4 
##    Estonia   Ethiopia Faeroe Isl Falkland I       Fiji    Finland     France 
##        189         27          8          4         17       1853        854 
## French Gui French Pol      Gabon     Gambia    Georgia    Germany      Ghana 
##          7          8          4          5         30       1167         32 
##  Gibraltar     Greece  Greenland    Grenada Guadeloupe       Guam  Guatemala 
##         17        653          7         11          3         36         44 
##     Guinea Guinea-Bis     Guyana      Haiti   Honduras  Hong Kong    Hungary 
##          2          1         21         31         36        750        129 
##    Iceland      India  Indonesia       Iran       Iraq    Ireland     Israel 
##        159       2841        257        117         25       2102        515 
##      Italy Ivory Coas    Jamaica      Japan Johnston I     Jordan Kazakhstan 
##        454         10        129        398          3         82         16 
##      Kenya     Kuwait  Kyrgystan Lao P.Dem.     Latvia    Lebanon    Lesotho 
##         90         52          6          5        190        159          4 
##    Liberia Libyan Ara Liechtenst  Lithuania Luxembourg      Macau  Macedonia 
##          6          3          1        118         26         19         28 
## Madagascar     Malawi   Malaysia   Maldives       Mali      Malta Marshall I 
##          4          3        911         12          2        108          3 
## Martinique Mauritania  Mauritius     Mexico Micronesia    Moldova     Monaco 
##          6          1         30        700          6         12          4 
##   Mongolia Montserrat    Morocco Mozambique    Namibia      Nepal Netherland 
##          5          1         26          3         20         37       3469 
## New Caledo New Zealan  Nicaragua      Niger    Nigeria       Niue Norfolk Is 
##         13       2016         33          9         93          4          5 
## North Kore Northern M     Norway       Oman   Pakistan      Palau     Panama 
##          4         10       1058         17        296          5         42 
##  Papua New   Paraguay       Peru Philippine Pitcairn I     Poland   Portugal 
##          6         11        109       2488          3        411        455 
## Puerto Ric      Qatar Republic o    Reunion    Romania Russian Fe     Rwanda 
##        218         13          5          3        577        366          5 
## Saint Hele Saint Kitt      Samoa San Marino Saudi Arab    Senegal     Serbia 
##          2          3          5          1         98          5        169 
## Seychelles Sierra Leo  Singapore   Slovakia   Slovenia Solomon Is    Somalia 
##          7          5       2450         93        178          4          8 
## South Afri South Kore      Spain  Sri Lanka   St Lucia St Vincent      Sudan 
##        927        446        417         62         15          8         12 
##   Suriname Svalbard &  Swaziland     Sweden Switzerlan      Syria     Taiwan 
##          4          2          4       1352        217         24        248 
##   Tanzania   Thailand       Togo    Tokelau      Tonga Trinidad a    Tunisia 
##         14       2059          8          2          4        158         12 
##     Turkey Turkmenist  Turks and     Tuvalu     Uganda         UK    Ukraine 
##        396          7         21         11        120      16489        179 
## United Ara    Uruguay        USA Uzbekistan    Vanuatu    Vatican Vatican Ci 
##        196         45     212625         20          7          2          6 
##  Venezuela    Vietnam Virgin Isl   W. Samoa Wake Islan Wallis and Western Sa 
##        126        127         14          1          3          2          1 
##      Yemen Yugoslavia      Zaire     Zambia   Zimbabwe 
##          6        178          2         10         55
barplot(table(bigFiveData$country),cex.names = .25, main="Nationality")

Sada kad smo pregledali podatke koje imamo, možemo krenuti na testiranje hipoteza.

5.TEST

U posljednjem testu promatrat ćemo varijablu dobi (starosti) i uspoređivati ju sa svih 5 faktora koje ispitujemo. Prvo ćemo vidjeti povezanost dobi sa svim tim faktorima, nakon čega ćemo izabrati jedan na kojem ćemo raditi linearnu regresiju te na temelju tog faktora pokušati odrediti dob ispitanika.

Pa krenimo s testiranjem. Za početak ćemo podijeliti varijablu dobi, koja je numerička, na kategorije: mlađi(0-15 godina), srednje dobi(16-30 godina) i starije(30+ godina)..

young = bigFiveData[which(bigFiveData$age <= 15),]
middle = bigFiveData[which(bigFiveData$age > 15 & bigFiveData$age <= 30),]
old = bigFiveData[which(bigFiveData$age > 30),]

Nakon te podjele, gledat ćemo srednje vrijednosti pojedinog faktora i prikazivat ćemo box plotove, na temelju ćega ćemo zaključiit koji je faktor najpovezaniji s dobi i nastaviti raditi s njim linearnu regresiju.

EKTROVERZIJA

cat('Prosječna ocjena ekstraverzije mladih ljudi iznosi ', mean(young$extraversion_score), '\n')
## Prosječna ocjena ekstraverzije mladih ljudi iznosi  0.6924383
cat('Prosječna ocjena ekstraverzije srednjih ljudi iznosi ', mean(middle$extraversion_score), '\n')
## Prosječna ocjena ekstraverzije srednjih ljudi iznosi  0.6774276
cat('Prosječna ocjena ekstraverzije starijih ljudi iznosi ', mean(old$extraversion_score), '\n')
## Prosječna ocjena ekstraverzije starijih ljudi iznosi  0.6503976
boxplot(young$extraversion_score, middle$extraversion_score, old$extraversion_score,
        names = c('Young people extraversion score','Middle aged people extraversion score', 'Old people extraversion score'),
        main = 'Boxplot of young, middle aged and old people extraversion score')

UGODNOST

cat('Prosječna ocjena ugodnosti mladih ljudi iznosi ', mean(young$agreeable_score), '\n')
## Prosječna ocjena ugodnosti mladih ljudi iznosi  0.6671362
cat('Prosječna ocjena ugodnosti srednjih ljudi iznosi ', mean(middle$agreeable_score), '\n')
## Prosječna ocjena ugodnosti srednjih ljudi iznosi  0.6918796
cat('Prosječna ocjena ugodnosti starijih ljudi iznosi ', mean(old$agreeable_score), '\n')
## Prosječna ocjena ugodnosti starijih ljudi iznosi  0.7210159
boxplot(young$agreeable_score, middle$agreeable_score, old$agreeable_score,
        names = c('Young people agreeable score','Middle aged people agreeable score', 'Old people agreeable score'),
        main = 'Boxplot of young, middle aged and old people agreeable score')

SAVJESNOST

cat('Prosječna ocjena savjesnosti mladih ljudi iznosi ', mean(young$conscientiousness_score), '\n')
## Prosječna ocjena savjesnosti mladih ljudi iznosi  0.6476224
cat('Prosječna ocjena savjesnosti srednjih ljudi iznosi ', mean(middle$conscientiousness_score), '\n')
## Prosječna ocjena savjesnosti srednjih ljudi iznosi  0.6936849
cat('Prosječna ocjena savjesnosti starijih ljudi iznosi ', mean(old$conscientiousness_score), '\n')
## Prosječna ocjena savjesnosti starijih ljudi iznosi  0.7441107
boxplot(young$conscientiousness_score, middle$conscientiousness_score, old$conscientiousness_score,
        names = c('Young people conscientiousness score','Middle aged people conscientiousness score', 'Old people conscientiousness score'),
        main = 'Boxplot of young, middle aged and old people conscientiousness score')

NEUROTICIZAM

cat('Prosječna ocjena neuroticizma mladih ljudi iznosi ', mean(young$neuroticism_score), '\n')
## Prosječna ocjena neuroticizma mladih ljudi iznosi  0.5960167
cat('Prosječna ocjena neuroticizma srednjih ljudi iznosi ', mean(middle$neuroticism_score), '\n')
## Prosječna ocjena neuroticizma srednjih ljudi iznosi  0.5797046
cat('Prosječna ocjena neuroticizma starijih ljudi iznosi ', mean(old$neuroticism_score), '\n')
## Prosječna ocjena neuroticizma starijih ljudi iznosi  0.5513757
boxplot(young$neuroticism_score, middle$neuroticism_score, old$neuroticism_score,
        names = c('Young people neuroticism score','Middle aged people neuroticism score', 'Old people neuroticism score'),
        main = 'Boxplot of young, middle aged and old people neuroticism score')

OTVORENOST NOVIM ISKUSTVIMA

cat('Prosječna ocjena otvorenosti mladih ljudi iznosi ', mean(young$openness_score), '\n')
## Prosječna ocjena otvorenosti mladih ljudi iznosi  0.7281298
cat('Prosječna ocjena otvorenosti srednjih ljudi iznosi ', mean(middle$openness_score), '\n')
## Prosječna ocjena otvorenosti srednjih ljudi iznosi  0.7343365
cat('Prosječna ocjena otvorenosti starijih ljudi iznosi ', mean(old$openness_score), '\n')
## Prosječna ocjena otvorenosti starijih ljudi iznosi  0.7344109
boxplot(young$openness_score, middle$openness_score, old$openness_score,
        names = c('Young people openness score','Middle aged people openness score', 'Old people openness score'),
        main = 'Boxplot of young, middle aged and old people openness score')

Nakon što smo pogledali prosjeke i napravili box plotove, bez računanja testova za svaki faktor posebno, možemo vidjeti da je savjesnost najviše ovisna o dobi. Zbog toga sada biramo savjesnost i radimo daljnja testiranja za dob vs savjesnost ispitanika.

Prije svakog testiranja gdje pretpostavljamo normalnost, moramo ju pokazati. Za početak ćemo prikazati podatke u histogramu.

Histogram za savjesnost mlađih:

hist(young$conscientiousness_score, main='Younger people conscientiousness score', xlab='Conscientiousness score', ylab='Frequency')

Histogram za savjesnost srednjh:

hist(middle$conscientiousness_score, main='Middle aged people conscientiousness score', xlab='Conscientiousness score', ylab='Frequency')

Histogram za savjesnost starijih:

hist(old$conscientiousness_score, main='Older people conscientiousness score', xlab='Conscientiousness score', ylab='Frequency')

Nakon što smo napravili histograme na kojima odokativno možemo vidjeti da se radi o normalno distribuiranim podacima, napraviti ćemo i plotove da vidimo postoje li outlieri.

Na danom box-plotu vidimo da postoje outlieri, te ćemo zbog jednostavnosti i zbog prestpostavke normalnosti ukloniit te outliere.

Uklanjanje outliera za “young” ispitanike u stupcu za savjesnost:

Q1 <- quantile(young$conscientiousness_score, .25)
Q3 <- quantile(young$conscientiousness_score, .75)
IQR <- IQR(young$conscientiousness_score)

no_outliers_young <- subset(young, young$conscientiousness_score> (Q1 - 1.5*IQR) & young$conscientiousness_score< (Q3 + 1.5*IQR))

Uklanjanje outliera za “middle” ispitanike u stupcu za savjesnost:

Q1 <- quantile(middle$conscientiousness_score, .25)
Q3 <- quantile(middle$conscientiousness_score, .75)
IQR <- IQR(middle$conscientiousness_score)

no_outliers_middle <- subset(middle, middle$conscientiousness_score> (Q1 - 1.5*IQR) & middle$conscientiousness_score< (Q3 + 1.5*IQR))

Uklanjanje outliera za “old” ispitanike u stupcu za savjesnost:

Q1 <- quantile(old$conscientiousness_score, .25)
Q3 <- quantile(old$conscientiousness_score, .75)
IQR <- IQR(old$conscientiousness_score)

no_outliers_old <- subset(old, old$conscientiousness_score> (Q1 - 1.5*IQR) & old$conscientiousness_score< (Q3 + 1.5*IQR))

dim(no_outliers_old)
## [1] 68768     9
dim(old)
## [1] 69298     9

Pokušavamo ponovno box plot napraviti kada smo(izbacili outliere?):

boxplot(no_outliers_young$conscientiousness_score, no_outliers_middle$conscientiousness_score, no_outliers_old$conscientiousness_score,
        names = c('Young people conscientiousness score','Middle aged people conscientiousness score', 'Old people conscientiousness score'),
        main = 'Boxplot of young, middle aged and old people conscientiousness score')

Prosjeci ekstroverzije:

Histogram za ekstraverziju mlađih:

hist(young$extraversion_score, main='Younger people extraversion score', xlab='Extraversion score', ylab='Frequency')

Histogram za ekstraverziju mlađih:

hist(middle$extraversion_score, main='Middle people extraversion score', xlab='Extraversion score', ylab='Frequency')

Histogram za ekstraverziju starijih:

hist(old$extraversion_score, main='Older people extraversion score', xlab='Extraversion score', ylab='Frequency')

Na prethodnim histogramima možemo “na oko” vidjeti da se radi o normalnoj distibuciji, ali ćemo svakako provesti test za dokazeivanje normalnosti da budemo sigurniji.

Sada radimo Lilliefors test:

LINEARNA REGRESIJA Nakon provedenih 5 testova gdje smo uspoređivali dob sa svakim od 5 faktora odlučili smo se testirati početno, tj vidjeti možemo li na temelju dobi odrediti savjesnost.

Kad promatramo utjecaj samo jedne nezavisne varijable X na neku zavisnu varijablu Y, grafički je moguće dobiti jako dobar dojam o njihovom odnosu - tu je najčešće od pomoći scatter plot. Zbog toga ćemo prikazati te podatke na scatter plotu.

Scatter plot za dob vs otvorenost prema novim iskustvima:

plot(bigFiveData$openness_score, bigFiveData$age)

Scatter plot za dob vs ekstrovertiranost:

plot(bigFiveData$extraversion_score, bigFiveData$age)

Scatter plot za dob vs ugodnost:

plot(bigFiveData$agreeable_score, bigFiveData$age)

Scatter plot za dob vs savjesnost:

plot(bigFiveData$conscientiousness_score, bigFiveData$age)

Scatter plot za dob vs neurotizicizam:

plot(bigFiveData$neuroticism_score, bigFiveData$age)

Sada ćemo napraviti linearni model za svih tih 5 primjera.

Linearni modeli:

fit.opennes = lm(age~openness_score,data=bigFiveData)
fit.extraversion = lm(age~extraversion_score,data=bigFiveData)
fit.agreeable = lm(age~agreeable_score,data=bigFiveData)
fit.conscientiousness = lm(age~conscientiousness_score,data=bigFiveData)
fit.neuroticism = lm(age~neuroticism_score,data=bigFiveData)

Sada crtamo liniju linearne regresije za sve ove modele:

Dob vs otvorenost:

plot(bigFiveData$openness_score, bigFiveData$age) #graficki prikaz podataka 
lines(bigFiveData$openness_score,fit.opennes$fitted.values,col="red") #linija

Dob vs ekstroverzija:

plot(bigFiveData$extraversion_score, bigFiveData$age) #graficki prikaz podataka 
lines(bigFiveData$extraversion_score,fit.extraversion$fitted.values,col="red") #linija

Dob vs ugodnost:

plot(bigFiveData$agreeable_score, bigFiveData$age) #graficki prikaz podataka 
lines(bigFiveData$agreeable_score,fit.agreeable$fitted.values,col="red") #linija

Dob vs savjesnost:

plot(bigFiveData$conscientiousness_score, bigFiveData$age) #graficki prikaz podataka 
lines(bigFiveData$conscientiousness_score,fit.conscientiousness$fitted.values,col="red") #linija

Dob vs neuroticizam:

plot(bigFiveData$neuroticism_score, bigFiveData$age) #graficki prikaz podataka 
lines(bigFiveData$neuroticism_score,fit.neuroticism$fitted.values,col="red") #linija

Nakon što smo napravili 5 scatter plotova s regresijskim linijama, vidimo da najviše smisla ima uspoređivati dob sa savjesnošću. Napravili smo 5 scatter plotova za svaki od 5 faktora uspoređujući ga s dobi, i nakon toga smo napravili još 5 s regresijskom linijom. U skupu imamo previše podataka zbog čega scatter plotovi nisu pregledni, ali kada postavimo regresijsku liniju, možemo odokativno nešto i zaključiti.

Sada treba provjeriti da pretpostavke modela nisu (jako) narušene. Pritom su najbitnije pretpostavke o regresorima i o rezidualima (normalnost reziduala i homogenost varijance).

Normalnost reziduala provjerit ćemo grafički, pomoću q-q plota te statistički pomoću Kolmogorov-Smirnovljevog testa

selected.model = fit.conscientiousness
plot(selected.model$residuals)

Histogram:

hist((selected.model$residuals))

hist(rstandard(selected.model))

Q-Q plot:

 #q-q plot reziduala s linijom normalne distribucije
qqnorm(rstandard(selected.model)) 
qqline(rstandard(selected.model))

plot(selected.model$fitted.values,selected.model$residuals)

Kolmogorov Smirnovljev test:

ks.test(rstandard(fit.conscientiousness),"pnorm")
## Warning in ks.test(rstandard(fit.conscientiousness), "pnorm"): ties should not
## be present for the Kolmogorov-Smirnov test
## 
##  One-sample Kolmogorov-Smirnov test
## 
## data:  rstandard(fit.conscientiousness)
## D = 0.13807, p-value < 2.2e-16
## alternative hypothesis: two-sided
require(nortest)
## Loading required package: nortest

Lillieforsov test:

lillie.test(rstandard(fit.conscientiousness))
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  rstandard(fit.conscientiousness)
## D = 0.13807, p-value < 2.2e-16